home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / xljump.c < prev    next >
Text File  |  1985-04-08  |  2KB  |  105 lines
  1. /* xljump - execution context routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern CONTEXT *xlcontext;
  7. extern NODE *xlvalue;
  8. extern NODE *xlstack,*xlenv,*xlnewenv;
  9. extern int xltrace,xldebug;
  10.  
  11. /* xlbegin - beginning of an execution context */
  12. xlbegin(cptr,flags,expr)
  13.   CONTEXT *cptr; int flags; NODE *expr;
  14. {
  15.     cptr->c_flags = flags;
  16.     cptr->c_expr = expr;
  17.     cptr->c_xlstack = xlstack;
  18.     cptr->c_xlenv = xlenv;
  19.     cptr->c_xlnewenv = xlnewenv;
  20.     cptr->c_xltrace = xltrace;
  21.     cptr->c_xlcontext = xlcontext;
  22.     xlcontext = cptr;
  23. }
  24.  
  25. /* xlend - end of an execution context */
  26. xlend(cptr)
  27.   CONTEXT *cptr;
  28. {
  29.     xlcontext = cptr->c_xlcontext;
  30. }
  31.  
  32. /* xljump - jump to a saved execution context */
  33. xljump(cptr,type,val)
  34.   CONTEXT *cptr; int type; NODE *val;
  35. {
  36.     /* restore the state */
  37.     xlcontext = cptr;
  38.     xlstack = xlcontext->c_xlstack;
  39.     xlunbind(xlcontext->c_xlenv);
  40.     xlnewenv = xlcontext->c_xlnewenv;
  41.     xltrace = xlcontext->c_xltrace;
  42.     xlvalue = val;
  43.  
  44.     /* call the handler */
  45.     longjmp(xlcontext->c_jmpbuf,type);
  46. }
  47.  
  48. /* xlgo - go to a label */
  49. xlgo(label)
  50.   NODE *label;
  51. {
  52.     CONTEXT *cptr;
  53.     NODE *p;
  54.  
  55.     /* find a tagbody context */
  56.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  57.     if (cptr->c_flags & CF_GO)
  58.         for (p = cptr->c_expr; consp(p); p = cdr(p))
  59.         if (car(p) == label)
  60.             xljump(cptr,CF_GO,p);
  61.     xlfail("no target for go");
  62. }
  63.  
  64. /* xlreturn - return from a block */
  65. xlreturn(val)
  66.   NODE *val;
  67. {
  68.     CONTEXT *cptr;
  69.  
  70.     /* find a block context */
  71.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  72.     if (cptr->c_flags & CF_RETURN)
  73.         xljump(cptr,CF_RETURN,val);
  74.     xlfail("no target for return");
  75. }
  76.  
  77. /* xlthrow - throw to a catch */
  78. xlthrow(tag,val)
  79.   NODE *tag,*val;
  80. {
  81.     CONTEXT *cptr;
  82.  
  83.     /* find a catch context */
  84.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  85.     if ((cptr->c_flags & CF_THROW) && cptr->c_expr == tag)
  86.         xljump(cptr,CF_THROW,val);
  87.     xlfail("no target for throw");
  88. }
  89.  
  90. /* xlsignal - signal an error */
  91. xlsignal(emsg,arg)
  92.   char *emsg; NODE *arg;
  93. {
  94.     CONTEXT *cptr;
  95.  
  96.     /* find an error catcher */
  97.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  98.     if (cptr->c_flags & CF_ERROR) {
  99.         if (cptr->c_expr)
  100.         xlerrprint("error",NULL,emsg,arg);
  101.         xljump(cptr,CF_ERROR,NIL);
  102.     }
  103.     xlfail("no target for error");
  104. }
  105.